Entrega grupal

Álvaro Pascual (DNI: 01672747-A), Rodrigo Castillo (DNI: 29624141-A), Marcos Martínez (DNI: 50635315-X), Jorge Mendoza (DNI: 51518202-L)

Paquetes necesarios

rm(list = ls())
library(tidyverse)
library(glue)
library(lubridate)
library(forcats)
library(dplyr)
library(ggplot2)
library(plotly)
library(patchwork)
library(mapSpain)

Datos

election_data <- read_csv(file = "./data/datos_elecciones_brutos.csv")
cod_mun <- read_csv(file = "./data/cod_mun.csv")
surveys <- read_csv(file = "./data/historical_surveys.csv")
abbrev <- read_csv(file = "./data/siglas.csv")

Pasamos la tabla de elecciones a tidy, hacemos una columna partido

election_tidy <- election_data |> 
  pivot_longer(cols = -c(tipo_eleccion:votos_candidaturas), names_to = "Partido", values_to = "votos") |> drop_na("votos")

Agrupar varios partidos a la misma sigla

abbrev_g<-abbrev |> 
  mutate(siglas=case_when(
    str_detect(denominacion, "PARTIDO SOCIALISTA|PSOE") ~ "PSOE",
    str_detect(denominacion, "PARTIDO POPULAR") ~ "PP",
    str_detect(denominacion, "CIUDADANOS-PARTIDO DE LA CIUDADANÍA|CIUDADANOS-PARTIDO DE LA CIUDADANIA") ~ "C's",
    str_detect(denominacion, "PARTIDO NACIONALISTA VASCO") ~ "PNV",
    str_detect(denominacion, "BLOQUE NACIONALISTA GALEGO") ~ "BNG",
    str_detect(denominacion, "CONVERGENCIA i UNIO|CONVERGENCIA I UNIO") ~ "CIU",
    str_detect(denominacion, "UNIDAS PODEMOS|PODEM|EZKER BATUA|IZQUIERDA UNIDA") ~ "UP",
    str_detect(denominacion, "ESQUERRA REPUBLICANA DE CATALUNYA") ~ "ERC",
    str_detect(denominacion, "SORTU|EUSKO|ALkARTASUNA|ARALAR|ALTERNATIBA") ~ "EH-BILDU",
    str_detect(denominacion, "MÁS PAÍS") ~ "MP",
    str_detect(denominacion, "VOX") ~ "VOX",
    TRUE ~ "OTROS",
  ))

Hacemos que si un partido tienen asiganda varias abreviaturas se quede con la primera y unimos elecciones con abreaviaturas, para que en elecciones salga la abrevaitura de cada partido

siglas_unique <- abbrev_g |> 
  distinct(denominacion, .keep_all = TRUE)

election_tidy_with_siglas <- election_tidy |> 
  left_join(siglas_unique, 
            by = c("Partido" = "denominacion"))

Separamos cod_mun en las 3 varibales de comunidad autonoma, provincia y municipio, para que coincidan con las de la tabla elecciones

cod_mun <- cod_mun |> 
  separate(cod_mun, 
           into = c("codigo_ccaa", "codigo_provincia", "codigo_municipio"), 
           sep = "-")

En la tabla surveys (encuestas) hacemos una columna partido, muy simliar al primero de elecciones, además quitamos los partidos que no tienen importancia en la encuesta, es decir que no han recibido datos

surveys_tidy <- surveys |> 
  pivot_longer(cols = -c(type_survey:turnout), names_to = "Partido", values_to = "value") |> 
  filter(year(date_elec) >= 2008 & year(date_elec) <= 2019) |> 
  drop_na("value")

Debes descartar las encuestas que: se refieran a elecciones anteriores a 2008, sean a pie de urna, tamaño muestral desconocido o inferior a 500, tenga 1 día o menos de trabajo de campo.

# Convertir las columnas de fecha a formato Date
surveys_clean <- surveys_tidy |> 
  mutate(
    date_elec = ymd(date_elec),
    field_date_from = ymd(field_date_from),
    field_date_to = ymd(field_date_to),
    field_duration = as.numeric(field_date_to - field_date_from)
  )

# Filtrar la base de datos según las condiciones
surveys_clean <- surveys_clean |> 
  filter(
    date_elec >= "2008-01-01",         
    exit_poll == FALSE,                
    !is.na(size) & size >= 500,        
    field_duration > 1                 
  )

12.a) ¿Qué partido fue el ganador en los municipios con más de 100.000 habitantes (censo) en cada una de las elecciones?

resultados_grandes_municipios <- election_tidy_with_siglas |> 
  filter(censo > 100000) |> 
  group_by(anno, Partido) |> 
  summarise(
    total_votos = sum(votos, na.rm = TRUE),
    .groups = "drop"  
  ) |> 
  group_by(anno) |> 
  slice_max(order_by = total_votos, n = 1) |> 
  ungroup()  
print(resultados_grandes_municipios)
# A tibble: 5 × 3
   anno Partido                           total_votos
  <dbl> <chr>                                   <dbl>
1  2008 PARTIDO POPULAR                       3376440
2  2011 PARTIDO POPULAR                       3430125
3  2015 PARTIDO POPULAR                       2272215
4  2016 PARTIDO POPULAR                       2503319
5  2019 PARTIDO SOCIALISTA OBRERO ESPAÑOL     3984926

12.b) ¿Qué partido fue el segundo cuando el primero fue el PSOE? ¿Y cuando el primero fue el PP?

# Obtener los dos primeros partidos por año
resultados_top2 <- election_tidy_with_siglas |> 
  filter(censo > 100000) |> 
  group_by(anno, Partido) |> 
  summarise(
    total_votos = sum(votos, na.rm = TRUE),
    .groups = "drop"
  ) |> 
  group_by(anno) |> 
  slice_max(order_by = total_votos, n = 2) |> 
  arrange(anno, desc(total_votos)) |> 
  mutate(posicion = row_number()) |> 
  pivot_wider(
    names_from = posicion,
    values_from = c(Partido, total_votos)
  )
print(resultados_top2)
# A tibble: 5 × 5
# Groups:   anno [5]
   anno Partido_1                         Partido_2  total_votos_1 total_votos_2
  <dbl> <chr>                             <chr>              <dbl>         <dbl>
1  2008 PARTIDO POPULAR                   PARTIDO S…       3376440       2899135
2  2011 PARTIDO POPULAR                   PARTIDO S…       3430125       1859062
3  2015 PARTIDO POPULAR                   PARTIDO S…       2272215       1344816
4  2016 PARTIDO POPULAR                   PARTIDO S…       2503319       1396916
5  2019 PARTIDO SOCIALISTA OBRERO ESPAÑOL PARTIDO P…       3984926       3191954

12.c) ¿A quién beneficia la baja participación?

election_tidy_with_participation <- election_tidy_with_siglas |> 
  mutate(participacion = votos / censo)

participacion_partido <- election_tidy_with_participation |> 
  group_by(anno, siglas) |> 
  summarise(
    participacion_media = mean(participacion, na.rm = TRUE),
    votos_totales = sum(votos, na.rm = TRUE),
    .groups = "drop"
  )

resultados_con_participacion <- participacion_partido |> 
  mutate(resultado_votos = votos_totales / sum(votos_totales) * 100)


colores_partidos <- c(
  "PSOE" = "#E30000",     
  "PP" = "#0000FF",       
  "C's" = "#FF6600",      
  "PNV" = "#006747",      
  "BNG" = "#0C6F6D",      
  "CIU" = "#9C3D28",    
  "UP" = "#6A0DAD",     
  "ERC" = "#E24D3A",      
  "EH-BILDU" = "#006F6F", 
  "MP" = "#00CFFF",       
  "VOX" = "#008000",      
  "OTROS" = "#BEBEBE"     
)


# Crear la gráfica de dispersión con los colores definidos y mejor estética
resultados <- ggplot(resultados_con_participacion, aes(x = participacion_media, y = resultado_votos, color = siglas)) + 
  geom_point(size = 3, alpha = 0.7) +  # Puntos con tamaño ajustado y transparencia
  geom_smooth(method = "lm", se = FALSE, aes(group = siglas), color = "black", linetype = "dashed") + # Línea de regresión por partido
  facet_wrap(~ anno, scales = "free_y") + # Facetas por año
  scale_color_manual(values = colores_partidos) + # Usar los colores definidos
  labs(
    title = "Relación entre Participación y Resultados Electorales por Año", 
    subtitle = "Cada punto representa un partido en una elección, con la participación y el porcentaje de votos",
    x = "Participación Media (%)",
    y = "Porcentaje de Votos (%)",
    color = "Partido"
  ) +
  theme_minimal(base_size = 14) +  # Estilo minimalista y tamaño de texto ajustado
  theme(
    legend.position = "bottom",  # Colocar la leyenda abajo
    legend.title = element_text(face = "bold", size = 12),  # Estilo de título de la leyenda
    legend.text = element_text(size = 10),  # Estilo de texto de la leyenda
    strip.text = element_text(face = "bold", size = 12),  # Estilo de los títulos de las facetas
    plot.title = element_text(face = "bold", size = 16, hjust = 0.5),  # Estilo del título
    plot.subtitle = element_text(size = 12, hjust = 0.5) # Estilo del subtítulo
  ) 

resultados_interactivo <- ggplotly(resultados)
resultados_interactivo

12.d) Relación entre el censo y el voto mediante un mapa:

indice <- election_data|>
  filter(anno==2019) |> 
  mutate("key"=glue("{codigo_provincia}-{codigo_municipio}")) |> 
  drop_na(votos_candidaturas, censo) |> 
   mutate("indice" = votos_candidaturas / censo) 

mapa<-mapSpain::esp_get_munic() |> 
     mutate("key"=glue("{cpro}-{cmun}"))
  
mapa_indice<- mapa |> 
  left_join(indice, by="key")

#Grafico de la participacion

g_ind<-ggplot(mapa_indice)+
  geom_sf(aes(alpha=indice, fill=indice), color=NA)+
  scale_alpha_continuous(range = c(0.7,0.9))+
  scale_fill_gradient2(low = "#b9feff",mid="#00c9ff", high = "#040b64", midpoint =
mean(indice$indice), labels = scales::label_number(scale = 100, suffix="%"))+
  labs(fill="PARTICIPACION",
       title = "PARTICIPACION 2019")+
  theme_minimal()+
      theme(
    axis.text = element_blank(),  # Eliminar etiquetas de los ejes
    axis.ticks = element_blank(),  # Eliminar marcas de los ejes
    legend.position = "bottom",  # Colocar la leyenda abajo
    legend.title = element_text(face = "bold", size = 12),  # Estilo de título de la leyenda
    legend.text = element_text(size = 8, angle = 30),  # Estilo de texto de la leyenda
    strip.text = element_text(face = "bold", size = 12),  # Estilo de los títulos de las facetas
    plot.title = element_text(face = "bold", size = 12, hjust = 0.5),  # Estilo del título
    plot.subtitle = element_text(size = 12, hjust = 0.5) # Estilo del subtítulo
    )+
    guides(alpha = "none")
  


#Grafico del censo de España
g_cen<-ggplot(mapa_indice)+
  geom_sf(aes(alpha=censo, fill=censo), color=NA)+
  scale_alpha_continuous(range = c(0.7,0.9))+
  scale_fill_gradient2(low = "#b9feff",mid="#00c9ff", high = "#040b64", midpoint =
mean(election_data$censo), transform = "log",labels = scales::label_number(scale = 1, accuracy = 1))+
  labs(title = "CENSO EN 2019")+
  theme_minimal()+
      theme(
    axis.text = element_blank(),  # Eliminar etiquetas de los ejes
    axis.ticks = element_blank(),  # Eliminar marcas de los ejes
    legend.position = "bottom",  # Colocar la leyenda abajo
    legend.title = element_text(face = "bold", size = 12),  # Estilo de título de la leyenda
    legend.text = element_text(size = 8, angle = 30),  # Estilo de texto de la leyenda
    strip.text = element_text(face = "bold", size = 12),  # Estilo de los títulos de las facetas
    plot.title = element_text(face = "bold", size = 12, hjust = 0.5),  # Estilo del título
    plot.subtitle = element_text(size = 12, hjust = 0.5) # Estilo del subtítulo
    )+
    guides(alpha = "none")


votos_censo<-g_ind+g_cen   #Sumamos las graficas para compararlas



ganadores_mun<-election_tidy_with_siglas |> 
  filter(anno==2019) |> 
  mutate("key"=glue("{codigo_provincia}-{codigo_municipio}")) |> 
  group_by(key) |> 
  drop_na(votos) |> 
  slice_max(votos)

  
ganadores_mun<-  ganadores_mun|>
  mutate("Tipo_mun"= if_else(censo>median(ganadores_mun$censo),"Urbana","Rural"))

graf_ganadores<-ggplot(ganadores_mun)+
  geom_bar(aes(x = siglas, fill = siglas))+
  scale_fill_manual(values = colores_partidos)+
  facet_wrap(~Tipo_mun)+
    labs(title = "GANADORES RURALES Y URBANOS 2019", 
         x= "PARTIDOS",
         y= "VICTORIAS")+
  theme_minimal()+
      theme(
    legend.position = "none",  # Quitar la leyenda
    strip.text = element_text(face = "bold", size = 12),  # Estilo de los títulos de las facetas
    plot.title = element_text(face = "bold", size = 12, hjust = 0.5),  # Estilo del título
    plot.subtitle = element_text(size = 12, hjust = 0.5), # Estilo del subtítulo
    axis.text = element_text(size = 10, angle = 30)
    )+
    guides(alpha = "none")

graf_ganadores<- ggplotly(graf_ganadores)
print(votos_censo)  
graf_ganadores

¿Cómo calibrar el error de las encuestas (recordemos que las encuestas son de intención de voto a nivel nacional)?

# Agrupar varios partidos a la misma sigla
surveys_clean_siglas <- surveys_clean |> 
  mutate(Partido=case_when(
    str_detect(Partido, "PSOE") ~ "PSOE",
    str_detect(Partido, "PP") ~ "PP",
    str_detect(Partido, "C's") ~ "C's",
    str_detect(Partido, "PNV") ~ "PNV",
    str_detect(Partido, "BNGO") ~ "BNG",
    str_detect(Partido, "CIU") ~ "CIU",
    str_detect(Partido, "UP") ~ "UP",
    str_detect(Partido, "ERC") ~ "ERC",
    str_detect(Partido, "EH-BILDU") ~ "EH-BILDU",
    str_detect(Partido, "MP") ~ "MP",
    str_detect(Partido, "VOX") ~ "VOX",
    TRUE ~ "OTROS",
  ))
# Calcular el porcentaje de votos por partido en las elecciones
votes_percentage <- election_tidy_with_siglas |> 
  group_by(anno, siglas) |> 
  summarise(total_votes = sum(votos, na.rm = TRUE), .groups = "drop_last") |> 
  mutate(percentage_votes = total_votes / sum(total_votes) * 100) |> 
  ungroup()

# Calcular el porcentaje de intención de voto por partido en las encuestas
survey_percentage <- surveys_clean_siglas |> 
  mutate(date_elec = year(date_elec)) |> 
  group_by(date_elec, Partido) |> 
  summarise(mean_intention = mean(value, na.rm = TRUE), .groups = "drop_last") |> 
  mutate(percentage_intention = mean_intention / sum(mean_intention) * 100) |> 
  ungroup()

# Unir ambas tablas y calcular el error
error_calibration <- votes_percentage |> 
  inner_join(survey_percentage, by = c("anno" = "date_elec", "siglas" = "Partido")) |>
  mutate(error = abs(percentage_votes - percentage_intention))
print(error_calibration)
# A tibble: 32 × 7
    anno siglas total_votes percentage_votes mean_intention percentage_intention
   <dbl> <chr>        <dbl>            <dbl>          <dbl>                <dbl>
 1  2008 CIU         774425             3.09          3.29                 3.52 
 2  2008 ERC         289641             1.16          2.34                 2.50 
 3  2008 OTROS      2834568            11.3           4.48                 4.79 
 4  2008 PNV         303264             1.21          1.79                 1.92 
 5  2008 PP         8739275            34.9          38.4                 41.1  
 6  2008 PSOE       8449416            33.7          42.2                 45.2  
 7  2008 UP          416106             1.66          0.889                0.952
 8  2011 ERC         244300             1.02          0.966                1.06 
 9  2011 OTROS      3674199            15.4           3.02                 3.30 
10  2011 PNV         323591             1.35          1.22                 1.34 
# ℹ 22 more rows
# ℹ 1 more variable: error <dbl>

¿Qué casas encuestadoras acertaron más y cuáles se desviaron más de los resultados?

# Calcular el porcentaje de error por casa encuestadora
media_errors <- surveys_clean_siglas |> 
  mutate(anno = year(date_elec)) |> 
  group_by(anno, Partido, media) |> 
  summarise(
    mean_intention = mean(value, na.rm = TRUE),
    .groups = "drop"
  ) |> 
  mutate(percentage_intention = mean_intention / sum(mean_intention) * 100) |> 
  inner_join(votes_percentage, by = c("anno", "Partido" = "siglas")) |> 
  mutate(error = abs(percentage_votes - percentage_intention))

# Calcular el error promedio por casa encuestadora
accuracy_by_media <- media_errors |> 
  group_by(media) |> 
  summarise(
    mean_error = mean(error, na.rm = TRUE),
    .groups = "drop"
  ) |> 
  arrange(mean_error)

# Identificar las casas encuestadoras más acertadas y más desviadas
medios_mas_acertados <- accuracy_by_media |> slice_min(order_by = mean_error, n = 5)
medios_menos_acertados <- accuracy_by_media |> slice_max(order_by = mean_error, n = 5)
print(medios_mas_acertados)
# A tibble: 5 × 2
  media       mean_error
  <chr>            <dbl>
1 HENNEO            10.2
2 INFOLIBRE         10.2
3 ESDIARIO          10.2
4 ELECTOMANÍA       10.2
5 RTVE–FORTA        10.2
print(medios_menos_acertados)
# A tibble: 5 × 2
  media            mean_error
  <chr>                 <dbl>
1 ANTENA 3               17.9
2 LA SEXTA               17.4
3 CADENA SER             16.8
4 PP                     16.6
5 EL INDEPENDIENTE       15.1

Ejercicios extras

¿Qué 10 partidos obtuvieron mejores resultados en comparación con las predicciones de las encuestas?

comparativa_partidos <- surveys_clean_siglas |> 
  mutate(anno = year(date_elec)) |> 
  group_by(anno, Partido) |> 
  summarise(
    mean_intention = mean(value, na.rm = TRUE),
    .groups = "drop"
  ) |> 
  mutate(percentage_intention = mean_intention / sum(mean_intention) * 100) |> 
  inner_join(votes_percentage, by = c("anno", "Partido" = "siglas")) |> 
  mutate(diferencia = percentage_votes - percentage_intention) |> 
  arrange(desc(diferencia)) |> 
  slice_max(order_by = diferencia, n = 10)
print(comparativa_partidos)
# A tibble: 10 × 7
    anno Partido mean_intention percentage_intention total_votes
   <dbl> <chr>            <dbl>                <dbl>       <dbl>
 1  2011 PP               43.3                10.1      10116652
 2  2008 PP               38.4                 9.00      8739275
 3  2008 PSOE             42.2                 9.88      8449416
 4  2016 PP               29.2                 6.85      7192478
 5  2015 UP                1.16                0.271     5340534
 6  2015 PP               27.3                 6.40      6530080
 7  2019 PSOE             28.1                 6.59     12556303
 8  2015 PSOE             22.4                 5.24      5000315
 9  2016 PSOE             21.5                 5.04      4702490
10  2011 OTROS             3.02                0.706     3674199
# ℹ 2 more variables: percentage_votes <dbl>, diferencia <dbl>

¿Cuál es la relación entre el tamaño del censo y la fragmentación del voto (índice de Herfindahl)? Representar los valores de fragmentación en un mapa por comunidades autonomas.

election_tidy_with_siglas <- election_tidy_with_siglas |> 
  mutate(codigo_ccaa = substr(codigo_ccaa, 1, 2))  


fragmentacion_ccaa <- election_tidy_with_siglas |> 
  group_by(codigo_ccaa, Partido) |> 
  summarise(votos_totales = sum(votos, na.rm = TRUE), censo_total = sum(censo, na.rm = TRUE), .groups = "drop") |> 
  group_by(codigo_ccaa) |> 
  reframe(
    indice_herfindahl = sum((votos_totales / sum(votos_totales, na.rm = TRUE))^2, na.rm = TRUE),
    censo_total = unique(censo_total)  
  )


mapa_ccaa <- mapSpain::esp_get_ccaa()

mapa_fragmentacion_ccaa <- mapa_ccaa |> 
  left_join(fragmentacion_ccaa, by = c("codauto" = "codigo_ccaa"))

graf_frag<-ggplot(mapa_fragmentacion_ccaa) +
  geom_sf(aes(fill = indice_herfindahl), color = "gray90", size = 0.1) +
  geom_sf_text(
    data = mapa_fragmentacion_ccaa |>  filter(!is.na(indice_herfindahl)),
    aes(label = sprintf("%.2f", indice_herfindahl)),
    size = 2,
    color = "black",
    fontface = "bold"
  ) +
  scale_fill_gradientn(
    colors = c("lightcoral", "gold", "forestgreen"),
    name = "Fragmentación",
    limits = c(0, 1),
    labels = scales::percent_format(accuracy = 1)
  ) +
  labs(
    title = "Fragmentación del Voto por Comunidades Autonomas en España",
    subtitle = "Índice de Herfindahl",
    fill = "Fragmentación (Herfindahl)"
  ) +
  coord_sf(datum = NA) + 
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5, size = 12),
    legend.position = "right",
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 8),
    panel.grid = element_blank()
  )
print(graf_frag)

Funcion para calcular la evolucion de votos de un partido

crecimiento_partido <- function(election_tidy) {
  # Calcular los votos totales por partido y año
  votos_agrupados <- election_tidy |> 
    group_by(anno, Partido) |> 
    summarise(total_votos = sum(votos, na.rm = TRUE), .groups = "drop")
  
  # Ordenar los datos por partido y año
  votos_ordenados <- votos_agrupados |> 
    arrange(Partido, anno)
  
  # Calcular el crecimiento o disminución porcentual entre elecciones consecutivas
  # Usamos lag() para obtener los votos del año anterior
  # En las elecciones en las que un determinado partido aparece por primera vez, el cambio
  # porcentual es 0
  crecimiento <- votos_ordenados |> 
    group_by(Partido) |> 
    mutate(cambio_pct = ifelse(is.na(lag(total_votos)), 0, (total_votos - lag(total_votos)) / lag(total_votos) * 100)) |> 
    ungroup()
  
  return(crecimiento)
}

¿Qué comunidad autónoma tiene la mayor participación electoral promedio en las elecciones entre 2008 y 2019?

codigo_a_comunidad <- c(
  "14" = "País Vasco",
  "07" = "Castilla La Mancha",
  "17" = "Comunidad Valenciana",
  "01" = "Andalucía",
  "08" = "Castilla y León",
  "10" = "Extremadura",
  "04" = "Islas Baleares",
  "09" = "Cataluña",
  "11" = "Galicia",
  "02" = "Aragón",
  "16" = "La Rioja",
  "12" = "Madrid",
  "15" = "Murcia",
  "13" = "Navarra",
  "03" = "Asturias",
  "05" = "Canarias",
  "06" = "Cantabria",
  "18" = "Ceuta",
  "19" = "Melilla"
)


participacion_media_ccaa <- election_tidy_with_siglas |> 
  group_by(codigo_ccaa) |> 
  summarise(
    participacion_promedio = mean(votos_candidaturas, na.rm = TRUE) / mean(censo, na.rm = TRUE) * 100
  ) 


participacion_media_ccaa <- participacion_media_ccaa |> 
  mutate(nombre_ccaa = codigo_a_comunidad[as.character(codigo_ccaa)])



participacion <- ggplot(participacion_media_ccaa, aes(x = reorder(nombre_ccaa, -participacion_promedio), y = participacion_promedio, fill = nombre_ccaa)) +
  geom_bar(stat = "identity", show.legend = FALSE, width = 0.8) +
  scale_fill_viridis_d(option = "D", begin = 0.2, end = 0.8) +  
  scale_y_continuous(limits = c(0, 100)) + 
  labs(
    title = "Comunidad Autónoma con Mayor Participación Electoral Promedio (2008-2019)",
    subtitle = "Participación promedio en las elecciones durante el período 2008-2019",
    x = "Comunidad Autónoma",
    y = "Participación Promedio (%)"
  ) +
  theme_minimal(base_size = 15) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1, size = 11, family = "Arial", color = "darkblue"),
    axis.text.y = element_text(size = 13, family = "Arial", color = "darkblue"),
    axis.title.x = element_text(size = 14, face = "bold", family = "Arial", color = "darkred"),
    axis.title.y = element_text(size = 14, face = "bold", family = "Arial", color = "darkred"),
    plot.title = element_text(size = 11, face = "bold", family = "Arial", color = "darkgreen"),
    plot.subtitle = element_text(size = 12, family = "Arial", color = "gray50"),
    plot.margin = margin(10, 20, 10, 20),
    panel.grid.major = element_line(color = "gray85", size = 0.5),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "white", color = "white"))

participacion_int <- ggplotly(participacion)
participacion_int

¿Cuál es la relación entre la participación electoral y el tamaño de la muestra de las encuestas?

encuestas_filtradas <- surveys_clean_siglas |> 
  filter(size >= 500)

participacion_por_partido <- encuestas_filtradas |> 
  group_by(Partido) |> 
  summarise(mean_participacion = mean(value, na.rm = TRUE))

partidos_colores <- c(
  "PSOE" = "#D50032",  
  "PP" = "#0056A0",    
  "C's" = "#FF6600",   
  "VOX" = "#006747",   
  "UP" = "#9B4F96",     
  "ERC" = "#D82B6D",    
  "PNV" = "#006A3E",    
  "MP" = "#03A9F4",     
  "EH-BILDU" = "#E32B5F",
  "CIU" = "#A7C3A4",    
  "BNG" = "#E60012",    
  "Otros" = "#BDBDBD"    
)

encuestas <- ggplot(participacion_por_partido, aes(x = reorder(Partido, -mean_participacion), y = mean_participacion, fill = Partido)) +
  geom_bar(stat = "identity", width = 0.7) +  
  scale_fill_manual(values = partidos_colores) +  
  labs(title = "Participación Electoral Promedio por Partido (Tamaño de Muestra > 500)",
       x = "Partido", y = "Participación Electoral Promedio (%)") +
  theme_minimal(base_size = 14) +  
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1, size = 12),  
    axis.text.y = element_text(size = 12),  
    plot.title = element_text(size = 12, face = "bold", hjust = 0.5),  
    legend.position = "none",  
    panel.grid.major.x = element_blank(),  
    panel.grid.minor.x = element_blank()   
  ) +
  coord_flip()

encuestas_int <- ggplotly(encuestas)
encuestas_int

¿Cómo han cambiado las categorías de votos (mayoría, empate, minoría) por provincia desde 2008 hasta 2019?

# Calcular el porcentaje de votos por provincia y año
datos_comparacion <- election_tidy |> 
  group_by(codigo_provincia, anno) |> 
  mutate(porcentaje_voto = votos / sum(votos) * 100)

# Definir las categorías de mayoría, empate y minoría
datos_comparacion$categoría <- case_when(
  datos_comparacion$porcentaje_voto > 50 ~ "Mayoría",
  datos_comparacion$porcentaje_voto >= 45 & datos_comparacion$porcentaje_voto <= 50 ~ "Empate",
  TRUE ~ "Minoría"
)

# Convertir 'categoría' en un factor ordenado
datos_comparacion$categoría <- fct_relevel(datos_comparacion$categoría, "Minoría", "Empate", "Mayoría")



# Gráfico único con la distribución de las categorías de votos por provincia y año
graf_distribucion<-ggplot(datos_comparacion, aes(x = fct_reorder(codigo_provincia, -porcentaje_voto), fill = categoría)) +
  geom_bar(stat = "count", position = "stack") +
  labs(title = "Distribución de las categorías de votos por provincia (2008 vs 2019)",
       x = "Provincia", y = "Número de votos", fill = "Categoría de voto") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1),
        legend.position = "none")
graf_distribucion_inter<-ggplotly(graf_distribucion)
graf_distribucion_inter

Posible dependencia

graf_dep<-ggplot(election_data, aes(x = sqrt(censo), y = sqrt(votos_blancos))) +
  geom_point(alpha = 0.6, color = "blue") + # Puntos de dispersión
  geom_smooth(method = "lm", color = "red", se = TRUE) + # Línea de tendencia (opcional)
  scale_x_continuous(labels = scales::comma) + # Formato del eje x
  scale_y_continuous(labels = scales::comma) + # Formato del eje y
  labs(
    title = "RELACION ENTRE CENSO Y VOTOS BLANCOS",
    x = "CENSO",
    y = "VOTOS BLANCOS"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14), # Estilo del título
    axis.title = element_text(face = "bold", size = 12), # Estilo de los ejes
    axis.text = element_text(size = 10) # Tamaño del texto en los ejes
  )
# Calculamos la correlacion

correlacion_1 <- cor(election_data$censo, election_data$votos_blancos, method = "pearson", use = "complete.obs")

graf_dep<-ggplotly(graf_dep)
print(paste("Coeficiente de correlación de Pearson:", round(correlacion_1, 2)))
[1] "Coeficiente de correlación de Pearson: 0.94"
graf_dep

¿Cuáles son las provincias con mayor y menor cambio en los votos entre 2008 y 2019?

# Calcular el cambio de votos entre 2008 y 2019 por provincia
cambio_votos <- election_tidy |> 
  filter(anno %in% c(2008, 2019)) |> 
  group_by(codigo_provincia, anno) |> 
  summarise(total_votos = sum(votos)) |> 
  spread(anno, total_votos) |> 
  mutate(cambio_votos = `2019` - `2008`)

# Crear gráfico de puntos para mostrar el cambio de votos por provincia
ggplot(cambio_votos, aes(x = fct_reorder(codigo_provincia, cambio_votos), y = cambio_votos)) +
  geom_point(size = 3, color = "blue") +
  geom_segment(aes(xend = codigo_provincia, yend = 0), color = "red") + # Línea que conecta con el eje 0
  labs(title = "Cambio de votos entre 2008 y 2019 por provincia",
       x = "Provincia", y = "Cambio en los votos") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))  # Mejor visualización de las provincias

¿Cuál es la tendencia esperada para los próximos 12 meses en el conjunto de datos?

library(forecast)


# Filtrar o seleccionar datos relevantes. Por ejemplo, para los datos de una provincia en específico:
election_data <- election_tidy |> 
  filter(codigo_provincia == "01") |>  
  select(votos, anno)  

# Convertir los datos en una serie temporal. Asegúrate de que 'anio' sea un valor numérico
ts_data <- ts(election_data$votos, start = c(min(election_data$anno), 1), frequency = 1)

# Ajustar el modelo ARIMA
model <- auto.arima(ts_data)

# Realizar el pronóstico para los próximos 12 meses
forecast_data <- forecast(model, h = 12)

# Graficar los resultados
graf<-autoplot(forecast_data) +
  ggtitle("Pronóstico para los Próximos 12 Meses") +
  xlab("dias") +
  ylab("Valor Esperado") +
  theme_minimal() +
  theme(
    plot.title = element_text(size = 16, face = "bold", hjust = 0.5),
    axis.title = element_text(size = 12, face = "bold"),
    axis.text = element_text(size=10)
)
graf<-ggplotly(graf)
graf